home *** CD-ROM | disk | FTP | other *** search
/ Loadstar 61 / 061.d81 / domino logic (.txt) < prev    next >
Encoding:
Commodore BASIC  |  1989-01-01  |  8.5 KB  |  252 lines
  1. 100 poke53281,0
  2. 110 print"[147]"chr$(142)"":gosub2280
  3. 120 rem *** load font
  4. 130 poke52,128:poke56,128:clr
  5. 140 poke147,0:sys57812"swapper.o",8,1:sys62631
  6. 145 sys57812"fnt1",8,0:poke780,0:poke781,0:poke782,128:sys65493
  7. 150 sys57812"fnt2",8,0:poke780,0:poke781,0:poke782,144:sys65493
  8. 160 ifpeek(783)and1thenprint"load error":end
  9. 170 rem *** init screen
  10. 175 poke53281,15:poke53280,15
  11. 180 poke56578,peek(56578)or3:poke56576,(peek(56576)and252)or1:poke648,136
  12. 185 dimcc%(12):fori=0to11:readcc%(i):next
  13. 187 data3,4,6,7,8,9,10,11,12,13,14,15
  14. 190 poke53272,32:i=rnd(0)
  15. 200 t1$="[144][147]        89<=[192][193][196][197][200][201]<=[204][205][208][209][212][213][216][217][220][221][160][161][146]   by[\_[144]"
  16. 210 t1$=t1$+"        :;>?[194][195][198][199][202][203]>?[206][207][210][211][214][215][218][219][255][223][162][163][146] dave]^[144] "
  17. 220 t1$=t1$+"                               johannsen":printt1$;
  18. 230 rem *** introduction
  19. 240 print"       do you want instructions?"
  20. 250 geta$:ifa$=""then250
  21. 260 ifa$="y"thengosub1500
  22. 270 print"           what size <2 to 9>  [157][157]"
  23. 280 geta$:ifa$=""then280
  24. 290 s=asc(a$)-asc("0"):ifs<2ors>9then270
  25. 300 print"              initializing...           "
  26. 310 dims%(11,10),d%(11,10),t%(55),x%(55),y%(55),h%(55),n%(55):y=0
  27. 320 rem *** compute initial directions
  28. 330 y=y+1:x=0:ify>s+1then470
  29. 340 x=x+1:ifx>s+2then330
  30. 350 ifd%(x,y)>0then340
  31. 360 ifx=s+2then410
  32. 370 ify=s+1then420
  33. 380 ifd%(x,y+1)>0then420
  34. 390 ifd%(x+1,y)>0then410
  35. 400 ifrnd(1)>.5then420
  36. 410 d%(x,y)=2:d%(x,y+1)=1:goto340
  37. 420 j=d%(x+1,y):d%(x,y)=3:d%(x+1,y)=4:onj+1goto340,430,440,450,340
  38. 430 x=x+1:y=y-1:d%(x,y)=0:goto350
  39. 440 d%(x+1,y+1)=0:goto340
  40. 450 d%(x+2,y)=0:goto340
  41. 460 rem *** get random domino order
  42. 470 j=1:forx=0tos:fory=0tox:ifrnd(1)>.5then490
  43. 480 x%(j)=x:y%(j)=y:goto500
  44. 490 x%(j)=y:y%(j)=x
  45. 500 j=j+1:nexty,x:n=j-1:n1=0:n2=0
  46. 510 fori=1ton:j=int(rnd(1)*n+1):x=x%(i):x%(i)=x%(j):x%(j)=x:x=y%(i):y%(i)=y%(j)
  47. 520 y%(j)=x:next:i=1
  48. 530 rem *** put dominos in grid
  49. 540 forx=1tos+2:fory=1tos+1:ond%(x,y)goto580,560,570,580
  50. 550 print"program error!":goto580
  51. 560 s%(x,y)=x%(i):s%(x,y+1)=y%(i):i=i+1:goto580
  52. 570 s%(x,y)=x%(i):s%(x+1,y)=y%(i):i=i+1
  53. 580 d%(x,y)=0:nexty,x:print"                                        "
  54. 590 rem *** print grid
  55. 600 poke34953-s,35:poke34958+s,36:poke35073+79*s,37:poke35078+81*s,38
  56. 610 fori=1to2*s+4:poke34953-s+i,33:poke35073+79*s+i,33:next
  57. 620 fori=1to2*s+2:poke34953-s+40*i,34:poke34958+s+40*i,34:next
  58. 630 fory=1tos+1:forx=1tos+2:i=34912-s+2*x+80*y:j=64+12*s%(x,y)
  59. 640 pokei,j:pokei+1,j+1:pokei+40,j+2:pokei+41,j+3:nextx,y
  60. 650 rem *** add dominos to the side
  61. 660 fory=0tos:forx=0toy:j=y*(y+1)/2+x:i=int(j/20):j=j-20*i:j=35010+40*j+2*i
  62. 670 pokej,236+x:pokej+1,246+y:nextx,y:x=1:y=1
  63. 680 poke35832,5:poke53271,0:poke53276,0:poke53277,0:poke53287,1:poke53269,1
  64. 690 rem *** add help
  65. 700 print"":fori=217to242:pokei,peek(i)or128:next
  66. 710 print"[144]c:color"
  67. 720 print"[144]h:help"
  68. 730 print"[144]u:undo"
  69. 740 print"[144]x:clear"
  70. 743 print"[144]e:erase"
  71. 745 print"[144]f:font"
  72. 746 print"[144]i:up"
  73. 747 print"[144]m:down"
  74. 748 print"[144]j:left"
  75. 749 print"[144]k:right"
  76. 750 print"[144]q:quit"
  77. 760 rem *** main loop
  78. 770 poke53249,66+16*y:x1=152-8*s+16*x:poke53248,x1and255:poke53264,x1/256
  79. 775 geta$
  80. 780 ifn1=nthen1920
  81. 790 j=31-(peek(56320)and31)
  82. 800 ifj=1ora$="[145]"theny=y+(y>1):goto770
  83. 810 ifj=2ora$=""theny=y-(y<=s):goto770
  84. 820 ifj=4ora$="[157]"thenx=x+(x>1):goto770
  85. 830 ifj=8ora$=""thenx=x-(x<=s+1):goto770
  86. 840 ifj=16ora$="e"thengosub1210:goto770
  87. 850 ifj=17ora$="i"thend=1:gosub990:goto770
  88. 860 ifj=18ora$="m"thend=2:gosub990:goto770
  89. 870 ifj=20ora$="j"thend=4:gosub990:goto770
  90. 880 ifj=24ora$="k"thend=3:gosub990:goto770
  91. 890 ifa$=""then770
  92. 900 ifa$<>"c"then910
  93. 905 cc=cc+1:ifcc>11thencc=0
  94. 907 poke53281,cc%(cc):poke53280,cc%(cc):goto770
  95. 910 ifa$="q"then1930
  96. 920 ifa$="h"thengosub2050:goto770
  97. 930 ifa$="x"thenforx=1tos+2:fory=1tos+1:gosub1210:nexty,x:x=1:y=1:goto770
  98. 935 ifa$="f"thensys828:goto770
  99. 940 ifa$<>"u"then770
  100. 950 j=0:fori=1ton:ifn%(i)>jthenj=n%(i):a=i
  101. 960 next:ifj=0then770
  102. 970 x=x%(a):y=y%(a):gosub1210:goto770
  103. 980 rem *** take square x,y in dir. d
  104. 990 ondgoto1000,1010,1020,1030
  105. 1000 e=2:x1=x:y1=y-1:on(y1<1)+2goto1190,1040
  106. 1010 e=1:x1=x:y1=y+1:on(y1>s+1)+2goto1190,1040
  107. 1020 e=4:x1=x+1:y1=y:on(x1>s+2)+2goto1190,1040
  108. 1030 e=3:x1=x-1:y1=y:ifx1<1then1190
  109. 1040 a=s%(x,y):b=s%(x1,y1):ifb<athenj=b:b=a:a=j
  110. 1050 ab=b*(b+1)/2+a+1:ift%(ab)then1370
  111. 1060 x%(ab)=x:y%(ab)=y:x=x1:y=y1:gosub1210:x=x%(ab):y=y%(ab):n1=n1+1:t%(ab)=1
  112. 1070 c=15:gosub2010:d%(x,y)=d:d%(x1,y1)=e:n2=n2+1:n%(ab)=n2
  113. 1080 j=64+12*s%(x,y):k=64+12*s%(x1,y1)
  114. 1090 i=34912-s+2*x+80*y:ondgoto1100,1120,1140,1160
  115. 1100 pokei-80,k+4:pokei-79,k+5:pokei-40,k+6:pokei-39,k+7
  116. 1110 pokei,j+10:pokei+1,j+11:pokei+40,j+6:pokei+41,j+7:goto1180
  117. 1120 pokei,j+4:pokei+1,j+5:pokei+40,j+6:pokei+41,j+7
  118. 1130 pokei+80,k+10:pokei+81,k+11:pokei+120,k+6:pokei+121,k+7:goto1180
  119. 1140 pokei,j+4:pokei+1,j+5:pokei+40,j+6:pokei+41,j+7
  120. 1150 pokei+2,k+8:pokei+3,k+5:pokei+42,k+9:pokei+43,k+7:goto1180
  121. 1160 pokei-2,k+4:pokei-1,k+5:pokei+38,k+6:pokei+39,k+7
  122. 1170 pokei,j+8:pokei+1,j+5:pokei+40,j+9:pokei+41,j+7
  123. 1180 j=peek(56320)and31:ifj<31then1180
  124. 1190 return
  125. 1200 rem *** remove domino at x,y
  126. 1210 ifd%(x,y)=0thenreturn
  127. 1220 i=34912-s+2*x+80*y:f=s%(x,y):j=64+12*f
  128. 1230 pokei,j:pokei+1,j+1:pokei+40,j+2:pokei+41,j+3
  129. 1240 ond%(x,y)goto1250,1270,1290,1310
  130. 1250 f1=s%(x,y-1):k=64+12*f1:d%(x,y-1)=0
  131. 1260 pokei-80,k:pokei-79,k+1:pokei-40,k+2:pokei-39,k+3:goto1330
  132. 1270 f1=s%(x,y+1):k=64+12*f1:d%(x,y+1)=0
  133. 1280 pokei+80,k:pokei+81,k+1:pokei+120,k+2:pokei+121,k+3:goto1330
  134. 1290 f1=s%(x+1,y):k=64+12*f1:d%(x+1,y)=0
  135. 1300 pokei+2,k:pokei+3,k+1:pokei+42,k+2:pokei+43,k+3:goto1330
  136. 1310 f1=s%(x-1,y):k=64+12*f1:d%(x-1,y)=0
  137. 1320 pokei-2,k:pokei-1,k+1:pokei+38,k+2:pokei+39,k+3
  138. 1330 iff>f1theni=f:f=f1:f1=i
  139. 1340 f2=f1*(f1+1)/2+f+1:t%(f2)=0:d%(x,y)=0:n%(f2)=0
  140. 1350 n1=n1-1:f2=b:b=f1:f1=a:a=f:c=0:gosub2010:a=f1:b=f2:return
  141. 1360 rem *** blink existing domino
  142. 1370 y1=y%(ab):x1=x%(ab):i=55392-s+2*x1+80*y1
  143. 1380 ond%(x1,y1)goto1390,1400,1410,1420
  144. 1390 j=i-80:goto1430
  145. 1400 j=i+80:goto1430
  146. 1410 j=i+2:goto1430
  147. 1420 j=i-1
  148. 1430 pokei,2:pokei+1,2:pokei+40,2:pokei+41,2
  149. 1440 pokej,2:pokej+1,2:pokej+40,2:pokej+41,2
  150. 1450 pokei,0:pokei+1,0:pokei+40,0:pokei+41,0
  151. 1460 pokej,0:pokej+1,0:pokej+40,0:pokej+41,0
  152. 1470 f=peek(56320)and31:iff<31then1430
  153. 1480 return
  154. 1490 rem *** intro message
  155. 1500 printt1$;""
  156. 1505 print"        the rules of the game
  157. 1510 [153]"i will form a rectangle of dominos; and"
  158. 1520 [153]"then i will remember where each of the"
  159. 1530 [153]"numbers is located:  i will then remove"
  160. 1540 [153]"the dominos:  your job is to determine"
  161. 1550 [153]"how to place the dominos back to form"
  162. 1560 [153]"the rectangle:  all of the dominoes in
  163. 1562 print"the stockpile on the right will be
  164. 1563 [153]"used and the grid will be completely
  165. 1564 print"covered:
  166. 1565 [153]"your answer may be different from mine:
  167. 1580 gosub 1880
  168. 1590 print"[145]          using the joystick"
  169. 1600 print"put the square cursor over the half"
  170. 1610 print"of the domino you want to place; then;
  171. 1620 [153]"while pushing the firebutton; push the
  172. 1630 print"stick in the direction of the other
  173. 1640 [153]"half:  pressing the button again will
  174. 1650 print"erase the domino:
  175. 1660 [153]"          using the keyboard
  176. 1662 print"use the crsr keys to place the cursor
  177. 1670 [153]"and the i; j; k and m keys to place the
  178. 1675 print"domino:  press e to erase the domino:
  179. 1680 [153]"if the domino has already been used;
  180. 1690 print"the matching domino will blink:
  181. 1695 [141]1880
  182. 1700 [153]"on           the stockpile"
  183. 1710 [153]"to the right of the playing grid the
  184. 1720 print"unused dominoes are listed:  if you
  185. 1730 [153]"press h for help; the dominoes that
  186. 1740 print"cannot be placed will turn red; and the
  187. 1750 [153]"dominoes that can only be placed in one
  188. 1760 print"position will be green:
  189. 1770 [153]"press c to change background color:
  190. 1780 print"press u to take back your last move:
  191. 1790 [153]"press x to clear the whole grid:
  192. 1800 print"press f to switch fonts:
  193. 1805 [153]"press q to quit to loadstar:
  194. 1810 gosub1880
  195. 1820 return
  196. 1870 rem *** wait for any key
  197. 1880 print"       press any key to continue[144]";
  198. 1890 geta$:ifa$=""then1890
  199. 1900 printt1$;"":return
  200. 1910 rem *** end game code
  201. 1920 fort=0to1000:next
  202. 1925 poke53269,0:printt1$;"             y o u   w o n":goto1940
  203. 1930 poke53269,0:printt1$;"           g a m e   o v e r"
  204. 1940 print"             another game ?"
  205. 1945 geta$:ifa$=""then1945
  206. 1950 ifa$="y"thenclr:goto180
  207. 1960 poke648,4:poke53272,20:poke56576,(peek(56576)and252)or3:print"[147]"
  208. 1970 open15,8,15,"r0:hello connect=hello connect":input#15,er%:close15
  209. 1980 ifer%<>63thenend
  210. 1990 poke646,peek(53281):print"[147]load"chr$(34)"hello connect"chr$(34)",8"
  211. 1995 print"run"
  212. 1997 poke631,13:poke632,13:poke198,2:end
  213. 2000 rem *** set hint domino ab to color c
  214. 2010 ifb<athenj=b:b=a:a=j
  215. 2020 j=b*(b+1)/2+a
  216. 2030 i=int(j/20):j=j-20*i:j=55490+40*j+2*i:pokej,c:pokej+1,c:return
  217. 2040 rem *** hint code
  218. 2050 print"             please wait:::";
  219. 2060 fori=1to55:h%(i)=0:next:x1=x:y1=y
  220. 2070 forx=1tos+2:fory=1tos+1:ifd%(x,y)>0then2160
  221. 2080 f=s%(x,y):ifx=s+2then2120
  222. 2090 ifd%(x+1,y)>0then2120
  223. 2100 a=s%(x+1,y):b=f:ifb<athenb=a:a=f
  224. 2110 j=b*(b+1)/2+a+1:h%(j)=h%(j)+1
  225. 2120 ify=s+1then2160
  226. 2130 ifd%(x,y+1)>0then2160
  227. 2140 a=s%(x,y+1):b=f:ifb<athenb=a:a=f
  228. 2150 j=b*(b+1)/2+a+1:h%(j)=h%(j)+1
  229. 2160 nexty,x:fora=1ton:ift%(a)thenh%(a)=-1
  230. 2170 next:b=0:fora=1ton
  231. 2180 ifh%(a)=0thenc=2:j=a-1:gosub2030:b=1
  232. 2190 ifh%(a)=1thenc=5:j=a-1:gosub2030:b=1
  233. 2200 next:print"                             ";:ifb=0then2250
  234. 2210 j=peek(56320)and31:geta$:if(j=31)and(a$="")then2210
  235. 2220 print"             please wait:::";
  236. 2230 fora=1ton:ift%(a)=0thenc=0:j=a-1:gosub2030
  237. 2240 next:x=x1:y=y1:print"                             ";:return
  238. 2250 print"             sorry; no help[144]";
  239. 2260 j=peek(56320)and31:geta$:if(j=31)and(a$="")then2260
  240. 2270 x=x1:y=y1:print"                             ";:return
  241. 2280 poke214,15:print:print"  [155][184][184][184][184][184][184][184][184][184][184][184][184][184][184][184][184][184][184][184][184][184][184][184][184][184][184][184][184][184][184][184][184][184][184][184][184][152]"
  242. 2290 fori=1to3:print"                                      ":next
  243. 2300 print"        [208]ublished on [204][207][193][196][211][212][193][210] #61     "
  244. 2310 print"      Subscriptions 1-800-831-2694    "
  245. 2320 print"     CHANGING[160]THIS[160]NOTICE[160]IS[160]ILLEGAL  "
  246. 2330 print"                                      "
  247. 2340 print"  [151][185][185][185][185][185][185][185][185][185][185][185][185][185][185][185][185][185][185][185][185][185][185][185][185][185][185][185][185][185][185][185][185][185][185][185][185]"
  248. 2350 au$="[196][207][205][201][206][207] [204][207][199][201][195]":poke214,17:print:printspc(20-len(au$)/2)"[152]"au$
  249. 2360 au$="[194]y [196]avid [202]ohannsen  ([195]) 1989":poke214,18:print
  250. 2370 printspc(20-len(au$)/2)"[152]"au$"":return
  251. 10000 open15,8,15,"s0:domino logic":close15:save"domino logic",8
  252.